-- Aufgabaenblatt 6

import Data.Char
import Data.List

data Nat = Z | S Nat

{--
natToRom :: Integer -> String
natToRom i
  | i == 0       = []
  | i > 1000     = digit 1000 : natToRom (i - 1000)
  | i < 4*l      = digit l : natToRom (i - l)
  | i < m        = digit dif1 : digit m : natToRom (i - m + dif1)
  | i < m + 4*l  = digit m : natToRom (i - m)
  | otherwise    = digit dif2 : digit u : natToRom (i - u + dif2)
  where
    m = l * 5
    dif1 = head $ dropWhile (\x -> i < m - x) pows
    dif2 = head $ dropWhile (\x -> i < u - x) pows

    u = head $ dropWhile (< i) pows
    l = last $ takeWhile (i >=) pows

    pows = [1,10,100,1000]

    digit n = snd . fromJust $ find (\x -> fst x == n) $
               zip [1,5,10,50,100,500,1000] "IVXLCDM"
--}

digits = [(1000,"M"),(999,"IM"),(990,"XM"),(900,"CM"),(500,"D"),(499,"ID")
         ,(490,"XD"),(400,"CD"),(100,"C"),(99,"IC"),(90,"XC"),(50,"L"),(49,"IL")
         ,(40,"XL"),(10,"X"),(9,"IX"),(5,"V"),(4,"IV"),(1,"I")]

int2Rom :: Integer -> String
int2Rom 0 = []
int2Rom i = int2Rom' i digits
  where
    int2Rom' i ((n,d):ds)
      | i >= n = d ++ int2Rom (i - n)
      | otherwise = int2Rom' i ds


nat2Int Z = 0
nat2Int (S n) = 1 + nat2Int n

int2Nat 0 = Z
int2Nat i = S (int2Nat (i - 1))

instance Show Nat where

  show = int2Rom . nat2Int

data RatNumbers = Rat Numerator Denominator
type Numerator = Nat
type Denominator = Nat

class Nf a where
  t2nf :: a -> a

nb2Dec :: String -> Integer
nb2Dec nb = sum $ zipWith (*) coeffs negBinPowers
   where
     l = length nb
     negBinPowers = [(-2)^i | i <- [(l-1),(l-2)..0]]
     coeffs = map (\x -> toInteger $ (ord x) - (ord '0')) nb

dec2nb :: Integer -> String
dec2nb n
  | n == 0 = "0"
  | otherwise = dec2nb' n
  where
    dec2nb' n
      | n == 0 = []
      | r < 0  = dec2nb' (q+1) ++ show (r+2)
      | r >= 0 = dec2nb' q ++ show r
      where
        r = n `mod` (-2)
        q = n `div` (-2)

coPrime (n,m)
  | g == 1 = (n,m)
  | otherwise = (n `div` g, m `div` g)
  where
    g = gcd n m

rnToReal (Rat n d) = nat2Int n / nat2Int d

instance Show RatNumbers where

  show (Rat n d) = (f n) ++ "/" ++ (f d)
    where
      f = dec2nb . nat2Int

instance Nf RatNumbers where

  t2nf (Rat n d) = Rat (int2Nat k) (int2Nat l)
    where
      (k,l) = coPrime (nat2Int n, nat2Int d)

instance Eq RatNumbers where

  (==) rn1 rn2 = (rnToReal rn1) == (rnToReal rn2)

instance Ord RatNumbers where

  (<=) rn1 rn2 = (rnToReal rn1) <= (rnToReal rn2)

instance Num RatNumbers where

  (*) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      (n1',d1') = (nat2Int n1,nat2Int d1)
      (n2',d2') = (nat2Int n2,nat2Int d2)

      n = int2Nat $ n1'*n2'
      d = int2Nat $ d1'*d2'

  (+) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      (n1',d1') = (nat2Int n1,nat2Int d1)
      (n2',d2') = (nat2Int n2,nat2Int d2)

      n = int2Nat $ n1'*d2' + n2'*d1'
      d = int2Nat $ d1'*d2'

  (-) (Rat n1 d1) (Rat n2 d2) = t2nf (Rat n d)
    where
      (n1',d1') = (nat2Int n1,nat2Int d1)
      (n2',d2') = (nat2Int n2,nat2Int d2)

      n = int2Nat $ n1'*d2' - n2'*d1'
      d = int2Nat $ d1'*d2'

  fromInteger i = Rat (int2Nat i) (S Z)

  abs r = r

  signum (Rat Z _) = Rat Z (S Z)
  signum _ = Rat (S Z) (S Z)


newtype NatP = NP (Nat,Nat) deriving Show

npNorm (NP (Z,n)) = NP (Z,n)
npNorm (NP (S (n), m)) = NP (n,S(m))

instance Nf NatP where

  t2nf (NP (Z,m)) = NP (Z,m)
  t2nf (NP (n,Z)) = NP (n,Z)
  t2nf (NP (S n,S m)) = t2nf $ NP (n,m)


--EOF --
